home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / SoundAndMusic / cmix / lib / hcmbst.f < prev    next >
Encoding:
Text File  |  1988-01-31  |  3.1 KB  |  44 lines

  1.       subroutine hcmbst(xlpt,xinit,a,sr)
  2. c------------------------------------------------                       hsu01090
  3. c     xlpt => loop time of the filter in secs                           hsu01100
  4. c     xinit  => initialization ? 0 = yes ; 1 = no                       hsu01110
  5. c     a      => array                                                   hsu01120
  6. c-------------------------------------------------                      hsu01130
  7.       dimension a(1005)                                                 hsu01150
  8.       pi=3.141592654
  9.       w=2.*pi/xlpt                                                      hsu01170
  10. c----------------- tuning filter coefficient                            hsu01180
  11. c     n => loop length                                                  hsu01190
  12.       n=aint(xlpt*sr)                                                   hsu01200
  13. c     pc => delay required from the allpass filter                      hsu01210
  14.       pc=sr*xlpt-n                                                      hsu01220
  15. c     cc => coefficient of the allpass filter                           hsu01230
  16.       cc=sin((w/sr-w/sr*pc)/2.)/sin((w/sr+w/sr*pc)/2.)                  hsu01240
  17. c---------------------------------------------------------------        hsu01250
  18.       a(1)=10.+n                                                        hsu01260
  19.       if (xinit) 2,1,2                                                  hsu01270
  20. 1     le=a(1)                                                           hsu01280
  21.       do 10 l=11,le                                                     hsu01290
  22.       a(l)=0.                                                           hsu01300
  23. 10    continue                                                          hsu01310
  24.       a(2)=xlpt                                                         hsu01320
  25. c--------- a(3) =>                                                      hsu01330
  26.       a(3)=0.                                                           hsu01340
  27. c--------- a(4) =>                                                      hsu01350
  28.       a(4)=0.                                                           hsu01360
  29. c--------- a(5) => delay line pointer                                   hsu01370
  30.       a(5)=10.                                                          hsu01380
  31. c--------- a(6) =>                                                      hsu01390
  32.       a(6)=0.                                                           hsu01400
  33. c--------- a(7) => input delay                                          hsu01410
  34.       a(7)=0.                                                           hsu01420
  35. c--------- a(8) => output delay                                         hsu01430
  36.       a(8)=0.                                                           hsu01440
  37. c--------- a(9) => allpass filter coefficient                           hsu01450
  38.       a(9)=cc                                                           hsu01460
  39.       a(1) = a(1) - 1
  40.       a(5) = a(5) - 1
  41. c.......adjustments for C
  42. 2     return                                                            hsu01470
  43.       end                                                               hsu01480
  44.